home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 2789.ZIP / M3TEST.BAS < prev    next >
BASIC Source File  |  1991-09-28  |  10KB  |  260 lines
  1. DECLARE SUB Monocheck ()
  2.  
  3. '/TEST PROGRAM FOR MENU 3 + POPHELP.
  4. ' Note that INCLUDEd files and the help text file MENU3.HLP must be
  5. ' available in the default drive/directory. The directory containing
  6. ' INCLUDE files may be specified via the Options/Set paths... menu.
  7. ' If you want the program to look for MENU3.HLP in a directory other
  8. ' than the default find helpath$ below and change it's assignment/
  9.  
  10. '$INCLUDE: 'MENU3DCL.BI'      '/FUNCTION declarations needed for Menu3/
  11.  
  12. DEFINT A-Z                    '/default for this module/
  13.  
  14. '/dimension arrays to hold main and submenu selections, quick
  15. ' keys and help page pointers. DIM to the number of main menu
  16. ' entries and number of longest submenu entries PLUS 1. This
  17. ' menu implementation has five main menu entries and the longest
  18. ' submenu has 12/
  19.  
  20. DIM menu$(1 TO 6, 1 TO 13)    '/main & submenu selections/
  21. DIM qkey(1 TO 6, 1 TO 13)     '/quick key selections/
  22. DIM query$(1 TO 6, 1 TO 13)   '/query$ is used to hold uppercase letters in
  23.                               ' the range A-Z. These control the context
  24.                               ' sensitivity of Pophelp when it is called
  25.                               ' from within an open menu. Each letter
  26.                               ' refers to a single page in a help text file.
  27.                               ' The letters are coded in the DATA statements
  28.                               ' also used to define menu entries and quick
  29.                               ' key selections. See manual QUICKREF.DOC and
  30.                               ' study the DATA statements at the end
  31.                               ' of this Module/
  32.  
  33. DIM spectrum(16)              '/spectrum(0..5) holds menus colours.
  34.                               ' spectrum(8..11) holds Pophelp colours.
  35.                               ' other spectrum() locations are used for
  36.                               ' other colours needed in this module.
  37.                               ' Study SUB Monocheck/
  38.  
  39.   menuentries = 5             '/5 main menu selections this implementation.
  40.                               ' Make sure you define the number of main menu
  41.                               ' entries before you call up the following
  42.                               ' INCLUDE file/
  43.  
  44. '$INCLUDE: 'MENU34.BI'        '/call up a routine to fill menu$(), qkey()
  45.                               ' and query$() from DATA statements/
  46.  
  47. '/go set colours according to monitor in use/
  48.  
  49.   CALL Monocheck              '/not a quick library subroutine/
  50.  
  51. '**********************************************************************
  52. '/This section of code (between the asterisks) is included for
  53. ' demonstration purposes only and may be deleted without
  54. ' affecting the operation of the Menus or Pophelp/
  55.  
  56. '/Fill screen with test background/
  57.  
  58.   LOCATE 1, 1
  59.   CALL clrbox(spectrum(12), 80, 24)   '/see manual QUICKREF.DOC for details/
  60.  
  61. '/do prompt line along row 25/
  62.  
  63.   COLOR spectrum(13), spectrum(14)
  64.   LOCATE 25, 1
  65.   PRINT "   Menu3 + Pophelp  "; CHR$(179);
  66.   PRINT "    F10 to Open Menu    F1 to call Help    Alt+X to Exit   ";
  67. '**************************************************************************
  68.  
  69. '/going to use Pophelp so we need to intialise/
  70.  
  71.   code$ = "08125414"    '/Pophelp will pop up screen row 08, column 12
  72.                         ' with a page size (including border) 54 columns
  73.                         ' wide and 14 rows deep. Include leading zeros
  74.                         ' where necessary, code$ must contain 8 digits/
  75.  
  76.   context$ = "X"        '/if we call Pophelp from outside the menu (i.e.
  77.                         ' from this module) it will pop up displaying the
  78.                         ' index/
  79.  
  80.   helpath$ = "MENU3.HLP"       '/tell Pophelp where it can find
  81.                                ' the help text file/
  82.  
  83.   CALL HelpInit(helpath$)             '/pass Pophelp the
  84.   CALL Popcode(code$, spectrum())     ' information it needs/
  85.  
  86. '**********************************
  87. '/now complete menu initialisation/
  88. '**********************************
  89.  
  90.   CALL M3Init(menuentries, menu$())   '/M3Init works out the
  91.                                       ' size of the menus/
  92.  
  93.   keycode = 0          '/keycode is needed by keypress()/
  94.   sh = 1               '/turn on shadowing. sh = 0 turns it off/
  95.   mrow = 2             '/screen row position of top of main menu bar/
  96.   mcol = 4             '/screen column position LH edge of main menu bar/
  97.  
  98.  
  99. '**********************************************************************
  100. '/Ready to go. Wait for call to display Menu3 or Pophelp Index or Quit/
  101. '**********************************************************************
  102.  
  103.   DO
  104.       
  105.     CALL keypress(keycode, 1)       '/wait for user input. See
  106.                                     ' QUICKREF.DOC for details on
  107.                                     ' using keypress()/
  108.  
  109.     SELECT CASE keycode
  110.        
  111.     CASE 1068                       '/F10 key calls menu/
  112.  
  113. '/open the menu/
  114.    
  115.     CALL M3Open(menu$(), qkey(), query$(), spectrum(), sh, mrow, mcol)
  116.  
  117. '/the menu is now open and control will not return to here until the user
  118. ' either makes a selection or presses the Escape key/
  119.  
  120. '/FUNCTION Getkey3 will return 13 if a selection was made. If the user
  121. ' dismissed the menu by pressing Escape then Getkey3 will return 27, in
  122. ' which case the menu will already have been cleared from the screen/
  123.    
  124.     IF Getkey3 = 13 THEN          '/a selection was made/
  125.      
  126.       mainselection$ = RTRIM$(menu$(1, Getmain3))     '/extract main and
  127.       subselection$ = menu$(Getmain3 + 1, Getsub3)    ' submenu selections
  128.                                                       ' from menu$()/
  129.       COLOR 0, 7
  130.       LOCATE 23, 3: PRINT SPACE$(34)
  131.       LOCATE 22, 3
  132.       PRINT " Your last menu selection was:    ";
  133.       LOCATE 23, 4
  134.       PRINT mainselection$; "/"; subselection$;       '/display selections/
  135.      
  136.       IF subselection$ = "Call POPHELP Index" THEN
  137.         CALL PopHelp(context$, sh)                    '/open Pophelp in
  138.       END IF                                          ' response to menu
  139.                                                       ' selection/
  140.  
  141.       CALL M3Close                '/dismiss menus. You must explicitly
  142.     END IF                        ' dismiss the menu when a selection
  143.                                   ' has been made. If the user presses
  144.                                   ' <Escape> to dismiss the menu it is
  145.                                   ' dismissed automatically/
  146.  
  147.     CASE 1045                     '/Alt + X to terminate program/
  148.     EXIT DO
  149.  
  150.     CASE 1059                     '/F1 key also calls Pophelp from here/
  151.       CALL PopHelp(context$, sh)
  152.    
  153.     END SELECT
  154.   LOOP
  155.  
  156. '************************
  157. '/DATA statements follow/
  158. '************************
  159.  
  160. '/Main menu selections/
  161. '/Use trailing spaces to format your entries along the main menu bar.
  162. ' It's up to you not to overlap the RH end. Note that each selection is
  163. ' followed by a number and an uppercase letter. The number represents the
  164. ' POSITION in the preceding selection of the 'quick key' letter you want to
  165. ' highlight. The uppercase letter is the index to the help page you want
  166. ' Pophelp to display if the user presses F1 while the menu is open and
  167. ' the associated selection is highlighted. Each group of menu selections
  168. ' must end with ,#/
  169.  
  170.   DATA "Stars   ",1,C,"Constellations   ",1,C,"Planets   ",1,C
  171.   DATA "Signs                     ",2,C,Help,1,C,#
  172.  
  173. '/Submenu selections/
  174. '/Do not use any leading/trailing spaces in sub menu selections. If you
  175. ' want to place horizontal dividers in any submenu then code *,0,Z, in the
  176. ' positions you want (see 'Earth' in the 3rd. set of DATA statements below).
  177. ' Don't forget that a horizontal divider counts as one selection when you
  178. ' are totalling selections for the purposes of DIMensioning menu$() etc.
  179. ' Submenu selection lists must also end with ,#/
  180.  
  181.   DATA Arcturus,1,D,Betelgeuse,1,D,Sirius,1,D,Aldebaran,3,D
  182.   DATA Formalhaut,1,D,Canopus,1,D,Zubenelgenubi,1,D,#
  183.  
  184.   DATA Canis Major,1,D,Cassiopeia,7,D,Andromeda,1,D
  185.   DATA Ursa Minor,1,D,Corona Borealis,8,D,#
  186.  
  187.   DATA Mercury,3,D,Venus,1,D,*,0,Z,Earth,1,D,*,0,Z,Mars,1,D
  188.   DATA Jupiter,1,D,Saturn,1,D,Uranus,1,D,Neptune,1,D,Pluto,1,D,#
  189.  
  190.   DATA Capricorn,1,D,Aquarius,1,D,Pisces,1,D,Aries,2,D,Taurus,1,D,Gemini,1,D
  191.   DATA Cancer,3,D,Leo,1,D,Virgo,1,D,Libra,2,D,Scorpio,3,D,Sagittarius,1,D,#
  192.  
  193.   DATA Call POPHELP Index,14,X,#
  194.  
  195. END
  196.  
  197. SUB Monocheck STATIC
  198. SHARED spectrum()
  199.  
  200.   COLOR 7, 0
  201.   CLS
  202.   LOCATE 2, 3
  203.   PRINT "Press <C> for Colour"
  204.   LOCATE 3, 3
  205.   PRINT "Press <M> for Monochrome"
  206.  
  207.   DO
  208.     sel$ = INKEY$
  209.     IF UCASE$(sel$) = "M" THEN
  210.      
  211. '/not colour so set for mono monitor/
  212.  
  213.       spectrum(0) = 15
  214.       spectrum(1) = 0
  215.       spectrum(2) = 0
  216.       spectrum(3) = 7
  217.       spectrum(4) = 15
  218.       spectrum(5) = 0
  219.       spectrum(6) = 0
  220.       spectrum(8) = 0
  221.       spectrum(9) = 7
  222.       spectrum(10) = 0
  223.       spectrum(11) = 15
  224.       spectrum(12) = 0
  225.       spectrum(13) = 0
  226.       spectrum(14) = 7
  227.      
  228.       EXIT DO
  229.     ELSEIF UCASE$(sel$) = "C" THEN
  230.      
  231. '/Allocate menu colours/
  232.  
  233.       spectrum(0) = 14    '/highlighted letters (quick keys)/
  234.       spectrum(1) = 10    '/menu border/
  235.       spectrum(2) = 11    '/menu text/
  236.       spectrum(3) = 1     '/menu background/
  237.       spectrum(4) = 0     '/selected entries text/
  238.       spectrum(5) = 7     '/selected entries background/
  239.  
  240. '/allocate Pophelp colours/
  241.  
  242.       spectrum(8) = 14      '/page text/
  243.       spectrum(9) = 6       '/background/
  244.       spectrum(10) = 10     '/border/
  245.       spectrum(11) = 15     '/border text/
  246.  
  247. '/other colours needed for program/
  248.  
  249.       spectrum(12) = 2      '/screen backgound colour/
  250.       spectrum(13) = 0      '/initial prompt line foreground/
  251.       spectrum(14) = 7      '/initial prompt line background/
  252.      
  253.       EXIT DO
  254.     END IF
  255.   LOOP
  256.  
  257.  
  258. END SUB
  259.  
  260.